home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / ad.arc / ADTRANS.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-01-19  |  15.2 KB  |  300 lines
  1. 10  DEF SEG = &H40:POKE &H17, PEEK(&H17) AND 223
  2. 100  ARR$=CHR$(17)+CHR$(196)+CHR$(217)
  3. 110  DIM D$(13),V$(16),Q$(13),NOTE$(20),NKEY$(20),AZ$(3),AZ(3),W(13),D(16),U$(16),Z(3),G$(6)
  4. 115  O3$=CHR$(218)+CHR$(196)+CHR$(191):O4$=CHR$(179)+" "+CHR$(179):O5$=CHR$(192)+CHR$(196)+CHR$(217)
  5. 120  O$=CHR$(219):O2$=CHR$(221):O1$="F KEYS:"+O$+O$+"F1:MAIN menu"+O2$+"F9:TRANSFER menu"+O2$+"F7:NAMES"+O2$+"F8:NOTES":NKEY$(1)=""
  6. 130  FOR I=1 TO 13:READ Q$(I):NEXT
  7. 150  FOR I=1 TO 13:READ W(I):NEXT
  8. 160  DATA "NAME - SURNAME: ","NAME - FIRST:   ","TITLE:          ","COMPANY:        ","STREET:         ","CITY:           ","STATE:          ","ZIPCODE:        ","     HOME:      ","   OFFICE:      ","BIRTHDAY:       ","NOTE:           ","TELEPHONE:"
  9. 180  DATA 2,1,12,3,4,5,6,7,10,11,8,9,13
  10. 190  ON ERROR GOTO 1940
  11. 200  REM
  12. 290  REM         TEMPORARY FILE
  13. 295  OPEN "TEMPOR.TEM" FOR INPUT AS #1
  14. 296  INPUT #1,  FILE$,FILM$,FIL$:CLOSE #1:DIM ZK(40),ZL(40)
  15. 300  OPEN FILM$ FOR INPUT AS #3:ZTEST=0
  16. 310  INPUT #3,Y$,NRED,NN,FILE$,FIL$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F$:FOR I= 1 TO 36:INPUT #3, ZK(I):NEXT:CLOSE #3
  17. 312  FOR I= 1 TO 26:ZTEST=ZTEST+ZK(I):NEXT
  18. 315  OPEN FILE$ AS #4 LEN = 356
  19. 320  FIELD #4, 19 AS V$(1), 19 AS V$(2), 18 AS V$(13), 34 AS V$(12), 34 AS V$(3), 34 AS V$(4), 19 AS V$(5), 14 AS V$(6), 16 AS V$(7), 12 AS V$(8), 84 AS V$(9), 19 AS V$(10), 19 AS V$(11), 5 AS V$(14), 5 AS V$(15), 5 AS V$(16)
  20. 325  GET #4,NN+1:K1=VAL(V$(16)):IFIRST=K1:IEND=VAL(V$(14))
  21. 330  GOSUB 6000
  22. 333  GOSUB 6100
  23. 335  IF INEW>1 THEN GET #1,INEW+1:ISET=VAL(U$(16)):GET #1,ISET:ISEND=VAL(U$(15)):INEW1=INEW
  24. 340  GOTO 960
  25. 350  GOSUB 5100:GOSUB 6000:GOTO 960
  26. 400  A$="DELETE":Y1=3:GOTO 425
  27. 402  A$="EDIT":Y1=2:GOTO 425
  28. 405  A$="SORT":Y1=4:GOTO 425
  29. 410  A$="SEARCH":Y1=5:GOTO 425
  30. 415  A$="PRINT":Y1=6:GOTO 425
  31. 420  A$="MAIN":Y1=1
  32. 425  CLS:LOCATE 25,25:COLOR 1,7,1:PRINT "INTEGRATED SOFTWARE SYSTEMS";:COLOR 3,0:LOCATE 12,21:PRINT "PLEASE WAIT, LOADING ";A$;" ROUTINES"
  33. 430  IF ISET<INEW THEN GOSUB 5100:GOSUB 6200
  34. 435  A$="AD"+A$:RUN A$
  35. 450  GOSUB 6200
  36. 500  CLS:COLOR 3,0:LOCATE  12,30:PRINT "QUIT?  <Y>es or <N>o?":COLOR 14,0:LOCATE 12,38:PRINT "Y":LOCATE 12,47:PRINT "N":COLOR 3,0
  37. 505  GOSUB 560
  38. 510  IF Y$="N" THEN 350 ELSE A$="E":GOSUB 2190
  39. 520  CLS:LOCATE 12,30:PRINT "   GOODBYE   ":SYSTEM
  40. 550  GOSUB 5100:Y1=2:RETURN 960
  41. 560  GOSUB 35040:DEF SEG=0: POKE 1050, PEEK(1052)
  42. 561  Y$=INKEY$:IF Y$="" THEN 561 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  43. 563  IF Y$="N" OR Y$="Y" THEN RETURN ELSE 560
  44. 630  CLS:LOCATE 25,10:COLOR 1,7,1:PRINT X3$;FILE$;X4$;X5$;X1$;:COLOR 3,0:LOCATE 1,1:RETURN
  45. 690  PRINT TAB(10);"TRANSFER MENU":PRINT:PRINT "CHOOSE ONE OF THE FOLLOWING:  "
  46. 710  PRINT :COLOR 14,0:PRINT "   ";CHR$(186);"     ";O3$:PRINT "   ";CHR$(186);"     ";O4$:PRINT "   ";CHR$(25);"     ";O5$:COLOR 3,0
  47. 720  LOCATE 9,1:PRINT TAB(4);"M)anual selection":PRINT TAB(4);"N)otes":PRINT TAB(4);"Z)IPCODE":PRINT TAB(4);"L)IST of Transfered Records "
  48. 722  COLOR 14,0:LOCATE 9,4:PRINT "M":LOCATE 10,4:PRINT "N":LOCATE 11,4:PRINT "Z":LOCATE 12,4:PRINT "L":COLOR 31,0:LOCATE 6,11:PRINT "?":LOCATE ,,0:COLOR 3,0
  49. 725  COLOR 3,0:LOCATE 17,40:PRINT "KEY  F1 = Return to Main menu"
  50. 726  COLOR 14,0:LOCATE 18,40:PRINT "     F9";:COLOR 3,0:PRINT " = Return to TRANSFER menu"
  51. 727  LOCATE 19,40:PRINT "     F7 = List of names in Address Book"
  52. 728  LOCATE 20,40:PRINT "     F8 = KEYS used in NOTES"
  53. 729  LOCATE 21,40:PRINT "     F9 = Save/continue"
  54. 730  LOCATE 22,40:PRINT "    F10 = HELP"
  55. 731  LOCATE 23,40:PRINT "Alt F10 = QUIT"
  56. 732  LOCATE 1,67:PRINT "(C) 1983":LOCATE 2,62:PRINT "Date:  ";DATE$:LOCATE 3,62:PRINT "Time:  ":RETURN
  57. 960  REM
  58. 970   X1$="TRANSFER ":X3$="FILE = ":X5$="FUNCTION = ":X4$=SPACE$(30):Q$=CHR$(27)
  59. 980  GOSUB 630
  60. 990  GOSUB 690
  61. 1033  DEF SEG=0: POKE 1050, PEEK(1052)
  62. 1035  Y$=INKEY$:IF Y$="" THEN LOCATE 3,69:PRINT TIME$:GOTO 1035 ELSE 1040
  63. 1040  IF LEN(Y$)=2 THEN 1055 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  64. 1042  IF Y$="M" THEN 1090
  65. 1045  IF Y$="L" THEN 3300
  66. 1047  IF Y$="Z" THEN 3050
  67. 1050  IF Y$="N" THEN 3000 ELSE GOSUB 35040:GOTO 1033
  68. 1055  IF ASC(RIGHT$(Y$,1))=68 THEN 30000
  69. 1060  IF ASC(RIGHT$(Y$,1))=113 THEN 500 ELSE 990
  70. 1090  GOSUB 2200
  71. 1100  MS=0:GOSUB 9000
  72. 1110  LOCATE 1,1:PRINT "Manual Selection ...  ":LOCATE 3,28 :COLOR 12,0:PRINT "ENTER:  SURNAME & ";ARR$
  73. 1120  LOCATE 6,23:COLOR 12,0:PRINT "[!] & ";ARR$;" TO EXAMINE complete file":LOCATE 8,28:PRINT ARR$;"  return to EDIT menu":COLOR 3,0
  74. 1125  LOCATE 7,39:PRINT "OR":LOCATE 5,39:PRINT "OR":LOCATE 4,13:PRINT  "(full name or any part starting from left most character)"
  75. 1170  COLOR 14,0:LOCATE 20,32: INPUT "SURNAME ... ",S$:MM=LEN(S$):IF MM=0 THEN 960
  76. 1185  GOSUB 3500:GOSUB 5000
  77. 1186  GET #4,NN+1:K=VAL(V$(16)):K1=K:II=1:I1=0
  78. 1187  IF S$="!" THEN 1190 ELSE QK=ASC(LEFT$(S$,1)):IF QK>90 OR QK<65 THEN 1270 ELSE K=ZK(QK-64)
  79. 1188  IF K=0 THEN 1270
  80. 1190  LOCATE 1,70:COLOR 16,7:PRINT " WORKING ":COLOR 3,0:I1=I1+1:TEST=0:GET #4, K
  81. 1195  IF S$="!" THEN 1205
  82. 1200  IF S$<>MID$(V$(2),5,MM) THEN 1310
  83. 1205  LOCATE 1,70:PRINT SPACE$(9):COLOR 3,0:LOCATE 1,15:PRINT II;SPACE$(4):GOSUB 5400
  84. 1210  COLOR 3,0:DEF SEG=0: POKE 1050, PEEK(1052):GOSUB 35040
  85. 1215  Y$=INKEY$:IF Y$="" THEN 1215 ELSE DEF SEG=&H40:POKE &H17, 0
  86. 1220  IF Y$="Y" OR Y$="y" THEN I=II:K=VAL(V$(14)):GOSUB 2700:GOTO 1310
  87. 1225  IF LEN(Y$)=2 THEN Y$=RIGHT$(Y$,1)
  88. 1230  IF (Y$="N" OR Y$="n" OR Y$="Q")  THEN K=VAL(V$(14)) ELSE 1240
  89. 1235  IF II=NN THEN II=1:GOTO 1310 ELSE II=II+1 :GOTO 1310
  90. 1240  IF S$<>"!" THEN 1315 ELSE IF Y$="r" OR Y$="R" THEN 960
  91. 1245  IF Y$="=" THEN COLOR 14,0:LOCATE 23,20:PRINT "Jump to (1 - ";NN;" ) ... ";ARR$; ELSE 1255
  92. 1250  GOSUB 35030:DEF SEG =&H40:POKE &H17,PEEK(&H17) OR 32:INPUT NUM:DEF SEG=&H40:POKE &H17,PEEK(&H17) AND 223:GOSUB 1500:GOTO 1190
  93. 1255  IF Y$="-" THEN COLOR 14,0:LOCATE 23,20:PRINT "GO back #? ";ARR$;:GOTO 1265
  94. 1260  IF Y$="+" THEN COLOR 14,0:LOCATE 23,20:PRINT "GO forward #? ";ARR$; ELSE 1285
  95. 1265  GOSUB 35030:DEF SEG =&H40:POKE &H17,PEEK(&H17) OR 32
  96. 1270  INPUT " ",NI:JJ=I:I=NI:NI=ABS(NI):COLOR 3,0
  97. 1275  IF ABS(NI)>NN THEN LOCATE 23,20:GOSUB 35030:PRINT "OUTSIDE DATA RANGE.  1 TO";NN;:FOR K=1 TO 900:NEXT:LOCATE 23,10:PRINT SPACE$(68):I=JJ:GOTO 1255
  98. 1280  DEF SEG=&H40:POKE &H17,PEEK(&H17) AND 223:LOCATE 23,10:PRINT SPACE$(65):LOCATE 23,21:COLOR 0,7:PRINT "Hit <Scroll Lock> to stop at a RECORD.":COLOR 3,0:GOSUB 1400:GOTO 1210
  99. 1285  IF Y$="I" THEN K=VAL(V$(15)) ELSE 1295
  100. 1290  IF II=1  THEN II=NN:GOTO 1315 ELSE II=II-1:GOTO 1190
  101. 1295  IF Y$="G" THEN K=IFIRST:II=1:GOTO 1190
  102. 1305  IF Y$="O" THEN GET #4,IFIRST:K=VAL(V$(15)):II=NN:GOTO 1190
  103. 1310  IF S$="!" THEN 1190
  104. 1315  IF ZTEST=26 THEN K=VAL(V$(14)):GOTO 1320
  105. 1317  IF ASC(MID$(V$(2),5,1))<>QK THEN 1330 ELSE K=VAL(V$(14))
  106. 1320  MS=1:IF FRE(1)<800 THEN CHAIN "adedit.bas",1230,ALL
  107. 1325  IF I1=NN THEN 1330 ELSE 1190
  108. 1330  IF MS=1 THEN 1345
  109. 1335  LOCATE 22,1:PRINT "Person is not in the address book. Try again.  Hit any key to continue."
  110. 1340  Y$=INKEY$:IF Y$="" THEN 1340 ELSE 1090
  111. 1345  CLS:LOCATE 12,25:PRINT "ANY MORE SELECTIONS?  <Y> or <N> ":COLOR 14,0:LOCATE 12,48:PRINT "Y":LOCATE 12,55:PRINT "N":COLOR 3,0:GOSUB 560
  112. 1350  IF Y$="N" THEN ED$="":GOTO 970
  113. 1355  IF Y$="Y" OR Y$="y" THEN 1090
  114. 1400  IS=II:LOCATE 1,70:COLOR 16,7:PRINT " WORKING ":COLOR 3,0
  115. 1410  NII=ABS(NI):FOR NF = 1 TO NII
  116. 1415  DEF SEG=&H40:IF PEEK(&H17) AND 16 THEN 1470
  117. 1420  IF NI<0 OR Y$="-" THEN II=IS-NF:K=VAL(V$(15)):GET #4,K:GOTO 1425 ELSE K=VAL(V$(14)):GET #4,K:II=IS+NF
  118. 1425  IF II=<0 THEN II=NN+II
  119. 1426  IF II>NN THEN II=ABS(II-NN)
  120. 1430  COLOR 3,0:LOCATE 1,15:PRINT II;SPACE$(4):GOSUB 5400:NEXT
  121. 1455  LOCATE 23,20:PRINT SPACE$(40)
  122. 1460  Y$="":LOCATE 1,70:PRINT SPACE$(9):RETURN
  123. 1470  LOCATE 23,20:PRINT SPACE$(40)
  124. 1480  Y$="":LOCATE 1,70:PRINT SPACE$(9):RETURN
  125. 1500  IF NUM=<0 OR NUM>NN THEN GOSUB 35040:LOCATE 23,20:PRINT "REENTER NUMBER BETWEEN 1 - ";NN;"  ";SPACE$(5):ELSE 1505
  126. 1501  GOSUB 35030:DEF SEG =&H40:POKE &H17,PEEK(&H17) OR 32:LOCATE 23,51:INPUT NUM:DEF SEG=&H40:POKE &H17,PEEK(&H17) AND 223
  127. 1505  IF NUM=<0 OR NUM>NN THEN 1500 ELSE LOCATE 23,20:PRINT SPACE$(50)
  128. 1510  IF ABS(NUM-II)<10 AND NUM-II<0 THEN NZ=II-1:K=VAL(V$(15)):GOTO 1590
  129. 1515  IF NUM-II<10 AND NUM-II >=0 THEN NZ=II+1:K=VAL(V$(14)):LOCATE 23,20:PRINT SPACE$(50):GOTO 1550
  130. 1520  NZ=INT((NN/10)+0.5):FOR IZ=1 TO 10:IF NUM=<IZ*NZ THEN K=ZK(IZ+26):NZ=(IZ-1)*NZ:IZ=10
  131. 1525  NEXT
  132. 1540  IF NZ=0 THEN NZ=1
  133. 1550  LOCATE 1,70:COLOR 16,7:PRINT " WORKING ":COLOR 3,0
  134. 1560  FOR II=NZ TO NUM-1 :GET #4,K:K=VAL(V$(14)):NEXT
  135. 1570  LOCATE 1,70:PRINT SPACE$(9)
  136. 1580  RETURN
  137. 1590  LOCATE 23,20:PRINT SPACE$(50)
  138. 1595  LOCATE 1,70:COLOR 16,7:PRINT " WORKING ":COLOR 3,0
  139. 1600  FOR II=NZ TO NUM+1 STEP -1:GET #4,K:K=VAL(V$(15)):NEXT
  140. 1610  LOCATE 1,70:PRINT SPACE$(9):RETURN
  141. 1940  IF ERL=4010 THEN CLOSE #2: I=1:CLS:LOCATE 10,16:COLOR 14,0:PRINT "The file containing keys used in NOTES is empty":LOCATE 18,30:COLOR 0,7:PRINT "HIT ANY KEY TO CONTINUE":GOSUB 35010:COLOR 3,0 ELSE 1947
  142. 1941  Y$=INKEY$:IF Y$="" THEN 1941
  143. 1942  RESUME 350
  144. 1947  IF ERR = 61 THEN CLS:LOCATE 25,10:COLOR 1,7,1:PRINT "FILE = ";FILE$;SPACE$(10);"DISK FULL ":COLOR 7,1:LOCATE 1,1
  145. 1950  IF ERR = 61 THEN LOCATE 10,1:PRINT "DISK FULL.  LOAD FORMATTED DISK AND TYPE <CONT> AND RETURN ":COLOR 14,0:LOCATE 10,43:PRINT "CONT":BEEP:COLOR 3,0:STOP
  146. 1960  IF ERR = 61 THEN RESUME 350
  147. 1970  IF ERL =6130 THEN INEW=0:PT2$=PT$:LP2=LP1:LP2$=LP$:T2$="The Address Book":TN2=TN:ISET=1:ISEND=1:RESUME 6160
  148. 1990  RESUME 350
  149. 2120  REM         TEMPORARY FILE
  150. 2130  REM
  151. 2190  Y$=LEFT$(A$,1)
  152. 2191  OPEN FILM$ FOR OUTPUT AS #3
  153. 2192  WRITE #3, Y$,NRED,NN,FILE$,FIL$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F$
  154. 2193  FOR I= 1 TO 36:WRITE#3, ZK(I):NEXT:CLOSE #3
  155. 2195  RETURN
  156. 2200  GOSUB 9000:PRINT TAB(10);"TRANSFER ... ":PRINT:PRINT "CHOOSE ONE OF THE FOLLOWING:  "
  157. 2210  PRINT :COLOR 14,0:PRINT "   ";CHR$(186);"     ";O3$:PRINT "   ";CHR$(186);"     ";O4$:PRINT "   ";CHR$(25);"     ";O5$:COLOR 3,0
  158. 2220  LOCATE 9,1:PRINT TAB(4);"C)opy Records to ";FILET$:PRINT TAB(4);"T)ransfer Records to ";FILET$;" and Delete from ";FILE$
  159. 2225  COLOR 14,0:LOCATE 9,4:PRINT "C":LOCATE 10,4:PRINT "T":COLOR 31,0:LOCATE 6,11:PRINT "?":LOCATE ,,0:COLOR 3,0
  160. 2230  DEF SEG=0: POKE 1050, PEEK(1052)
  161. 2235  YT$=INKEY$:IF YT$="" THEN 2235 ELSE YT$=CHR$(ASC(YT$) AND &HDF)
  162. 2240  IF YT$="C" OR YT$="T" THEN RETURN ELSE GOSUB 35040:GOTO 2230
  163. 2300  REM
  164. 2305  LOCATE 23,10:COLOR 14,0:PRINT "RECORD TRANSFERED.  TO DELETE RECORD, CONFIRM BY ENTERING <OK>. ":Y$=INPUT$(2):IF Y$="OK" OR Y$="ok" OR Y$="Ok" THEN 2310 ELSE LOCATE 23,10:PRINT SPACE$(69):RETURN
  165. 2310  LOCATE 23,10:PRINT "PLEASE WAIT, DELETING RECORD";SPACE$(40)
  166. 2315  IF IEND=VAL(V$(16)) THEN IEND=VAL(V$(15))
  167. 2320  IF VAL(V$(16))<>NN THEN 2330 ELSE L1=VAL(V$(14)):L2=VAL(V$(15)):Z$(2)=V$(15):Z$(1)=V$(14)
  168. 2325  IF IFIRST=VAL(V$(16)) THEN IFIRST =L1:GOTO 2365 ELSE 2365
  169. 2330  Z(1)=VAL(V$(14)):Z(2)=VAL(V$(15)):Z(3)=VAL(V$(16)):Z$(1)=V$(14):Z$(2)=V$(15):Z$(3)=V$(16):IF IFIRST=Z(3) THEN IFIRST = Z(1):IEND=Z(2)
  170. 2335  IF IEND = NN THEN IEND =Z(3)
  171. 2340  GET #4,Z(1):LSET V$(15)=Z$(2):LSET V$(14)=V$(14):LSET V$(16)=V$(16):FOR J=1 TO 13:LSET V$(J)=V$(J):NEXT:PUT #4,Z(1)
  172. 2345  GET #4,Z(2):LSET V$(14)=Z$(1):LSET V$(16)=V$(16):LSET V$(15)=V$(15):FOR J=1 TO 13:LSET V$(J)=V$(J):NEXT:PUT #4,Z(2)
  173. 2350  GET #4,NN:LSET V$(16)=Z$(3):LSET V$(14)=V$(14):LSET V$(15)=V$(15):FOR J=1 TO 13:LSET V$(J)=V$(J):NEXT:L1=VAL(V$(14)):L2=VAL(V$(15)):L3=VAL(V$(16)):PUT #4,Z(3)
  174. 2355  GET #4,L1:LSET V$(15)=Z$(3):LSET V$(14)=V$(14):LSET V$(16)=V$(16):FOR J=1 TO 13:LSET V$(J)=V$(J):NEXT:PUT #4,L1
  175. 2360  GET #4,L2:LSET V$(14)=Z$(3):LSET V$(16)=V$(16):LSET V$(15)=V$(15):FOR J=1 TO 13:LSET V$(J)=V$(J):NEXT:PUT #4,L2:GOTO 2375
  176. 2365  GET #4,L1:LSET V$(15)=Z$(2):LSET V$(14)=V$(14):LSET V$(16)=V$(16):FOR J=1 TO 13:LSET V$(J)=V$(J):NEXT:PUT #4,L1
  177. 2370  GET #4,L2:LSET V$(14)=Z$(1):LSET V$(16)=V$(16):LSET V$(15)=V$(15):FOR J=1 TO 13:LSET V$(J)=V$(J):NEXT:PUT #4,L2
  178. 2375  NMID=INT(NN/2+0.5):GET #4,NN+1:LSET V$(14)=STR$(IEND):LSET V$(16)=STR$(IFIRST):LSET V$(15)=STR$(NMID):FOR J=3 TO 13:LSET V$(J)=V$(J):NEXT:LSET V$(1) = DATE$:LSET V$(2) = TIME$:PUT #4,NN
  179. 2380  MX=MX-1:NN=NN-1
  180. 2385  IF Y$="N" OR Y$="Z" THEN RETURN ELSE LOCATE 23,10:PRINT SPACE$(69):RETURN
  181. 2700  INEW=INEW+1:FOR J= 1 TO 13:LSET U$(J)=V$(J):NEXT:LSET U$(14)=STR$(INEW+1):LSET U$(15)=STR$(INEW-1):LSET U$(16)=STR$(INEW):PUT #1,INEW
  182. 2710  IF YT$="T" THEN 2300 ELSE RETURN
  183. 3000  :GOSUB 2200:GOSUB 9000
  184. 3010  PRINT "Selection ... NOTES:" :LOCATE 5,28
  185. 3020  PRINT "ENTER:  NOTES & ";ARR$:LOCATE 6,17:PRINT "Any nmber of characters starting from the left)"
  186. 3030  LOCATE 15,10:COLOR 14,0:INPUT "NOTES ... ",Z$:KK=9:X2$="notes":COLOR 3,0:MM=LEN(Z$):GOTO 3100
  187. 3050  GOSUB 2200:GOSUB 9000:CLS:PRINT "PRINT ... ZIPCODE":LOCATE 5,32:PRINT "ENTER:  ZIPCODE & ";ARR$:LOCATE 6,8:PRINT "(Any number of digits and always start from the left most digit)"
  188. 3080  LOCATE 15,25:COLOR 14,0:INPUT "ZIPCode ... ",Z$:KK=7:X2$=" ZIPCODE "
  189. 3100  MM=LEN(Z$):IF MM=0 THEN 960
  190. 3110  GET #4,NN+1:I=VAL(V$(16)):II=I:IK=0:NSET=NN
  191. 3120  GET #4,NN+1:I=VAL(V$(16)):II=I:IK=0
  192. 3130  IM=2:GOSUB 9000:LOCATE 1,1:PRINT "RECORDS TRANSFERED to ";FILET$:IF YT$="T" THEN LOCATE 1,40:PRINT "RECORDS DELETED FROM ";FILE$
  193. 3131  COLOR 0,7:LOCATE 22,30:PRINT "   Hit <Esc> to Exit   ":COLOR 3,0
  194. 3135  IF IM=>20 THEN 3130
  195. 3140  IF IK= NSET THEN 3200 ELSE IK=IK+1
  196. 3150  GET #4,I
  197. 3151  IF MM<>0  THEN 3160 ELSE IF VAL(MID$(V$(1),5,2))<>0 THEN 3190
  198. 3153  IF VAL(V$(KK))=0 THEN 3165 ELSE 3190
  199. 3160  IF Z$<>MID$(V$(KK),5,MM) THEN 3190
  200. 3165  IM=IM+1:LOCATE IM,1:PRINT MID$(V$(1),5,VAL(V$(1)));" ";MID$(V$(2),5,VAL(V$(2)))
  201. 3170  INEW=INEW+1:FOR J= 1 TO 13:LSET U$(J)=V$(J):NEXT:LSET U$(14)=STR$(INEW+1):LSET U$(15)=STR$(INEW-1):LSET U$(16)=STR$(INEW):PUT #1,INEW
  202. 3180  I=VAL(V$(14)):IF YT$="T" THEN LOCATE IM,50:PRINT MID$(V$(1),5,VAL(V$(1)));" ";MID$(V$(2),5,VAL(V$(2))):IK=IK-2:GOSUB 2315
  203. 3182  Y$=INKEY$:IF Y$=CHR$(27) THEN 3200
  204. 3185  IF YT$="T" THEN 3135
  205. 3190  I=VAL(V$(14)):GOTO 3135
  206. 3200  COLOR 0,7:PRINT " RECORDS TRANSFERED ":GOSUB 35000
  207. 3210  COLOR 0,7:LOCATE 22,30:PRINT "Hit any key to continue":COLOR 3,0
  208. 3220  YY$=INKEY$:IF YY$="" THEN 3220 ELSE 960
  209. 3300  CLS:LOCATE 25,10:COLOR 1,7,1:PRINT X3$;FILE$;X4$;X5$;X1$;
  210. 3310  COLOR 0,7:LOCATE 23,29:PRINT "   Hit <Esc> to Exit   ":COLOR 3,0
  211. 3315  LOCATE 1,1:PRINT "TRANSFERED to ";:COLOR 1,7:PRINT FILET$:PRINT :PRINT :PRINT:COLOR 14,0
  212. 3320  FOR I=1 TO INEW STEP 2
  213. 3325  Y$=INKEY$:IF Y$=CHR$(27) THEN 3370
  214. 3330  GET #1,I:PRINT STR$(I);".  ";MID$(U$(1),5,VAL(U$(1)))+" "+MID$(U$(2),5,VAL(U$(2)));
  215. 3335  LOCATE ,40:GET #1,I+1:PRINT STR$(I+1);".  ";MID$(U$(1),5,VAL(U$(1)))+" "+MID$(U$(2),5,VAL(U$(2)))
  216. 3350  MN=MN+1:IF MN<21 THEN 3365 ELSE COLOR 0,7:LOCATE 23,29:PRINT " Hit any key to continue ":COLOR 3,0:MN=0
  217. 3360  Y$=INKEY$:IF Y$="" THEN 3360
  218. 3365  NEXT
  219. 3370  IF MN=0 THEN 960 ELSE COLOR 0,7:LOCATE 23,29:PRINT "Hit any key to continue":COLOR 3,0
  220. 3375  Y$=INKEY$:IF Y$="" THEN 3375
  221. 3380  GOTO 960
  222. 3500  GOSUB 9000
  223. 3510  PRINT "RECORD #:  ":PRINT:PRINT "NAME:          ":FOR J= 3 TO 8:PRINT Q$(J):NEXT:PRINT Q$(12):RETURN
  224. 3520  LOCATE 1,15:PRINT SPACE$(50)
  225. 3530  FOR J= 2 TO 9:LOCATE 1+J,15:PRINT SPACE$(50):NEXT:RETURN
  226. 4000  IF ISET<INEW THEN GOSUB 5100:GOSUB 6200
  227. 4005  FILN$ =FIL$+".NTE"
  228. 4010  OPEN FILN$ FOR INPUT AS #2
  229. 4030  FOR I= 1 TO 20:INPUT #2, NKEY$(I),NOTE$(I):IF NKEY$(I)=CHR$(15) THEN 4035 ELSE NEXT
  230. 4035  NP=I-1:CLOSE #2:GOSUB 9000
  231. 4050  LOCATE 1,1:PRINT "NOTES:  KEYS":LOCATE 1,30:COLOR 14,0:PRINT "KEYS       ";:COLOR 3,0:PRINT " DESCRIPTION":FOR I=1 TO NP:COLOR 14,0:LOCATE 4+I,30:PRINT NKEY$(I);:COLOR 3,0:LOCATE ,40:PRINT " = ";NOTE$(I):NEXT
  232. 4086  LOCATE 20,28:COLOR 0,7:PRINT "HIT ANY KEY TO CONTINUE":COLOR 3,0:GOSUB 35030
  233. 4087  Y$=INKEY$:IF Y$="" THEN 4087
  234. 4090  RETURN 350
  235. 5000  REM
  236. 5010  COLOR 3,0:LOCATE 18,1:PRINT "TRANSFER?     <Y>es.":COLOR 14,0:LOCATE 18,16:PRINT "Y":COLOR 3,0
  237. 5020  IF S$="!" THEN LOCATE 19,15:PRINT "<PgDn> or <N>o - next record.":LOCATE 19,26:COLOR 14,0:PRINT "N" :LOCATE 19,16:PRINT "PgDn" ELSE LOCATE 19,15:PRINT "<N>o.":LOCATE 19,16:COLOR 14,0:PRINT "N"
  238. 5030  IF S$<> "!" THEN RETURN ELSE COLOR 3,0:LOCATE 20,15:PRINT "<PgUp> - previous record":LOCATE 21,15:PRINT "<+> Scan forward ":COLOR 14,0:LOCATE 20,16:PRINT "PgUp":LOCATE 21,16:PRINT "+"
  239. 5035  LOCATE 19,50:COLOR 3,0:PRINT "<Home> - First record.":LOCATE 19,51:COLOR 14,0:PRINT "Home" :COLOR 3,0:LOCATE 20,50:PRINT "<End> - Last record.":LOCATE 20,51:COLOR 14,0:PRINT "End"
  240. 5036  COLOR 3,0:LOCATE 21,50:PRINT "<-> Scan backward":LOCATE 21,51:COLOR 14,0:PRINT "-":COLOR 3,0
  241. 5038  COLOR 3,0:LOCATE 22,15:PRINT "<=> Jump ":LOCATE 22,16:COLOR 14,0:PRINT "=":COLOR 3,0
  242. 5040  LOCATE 22,50:PRINT "<";:COLOR 14,0:PRINT "R";:COLOR 3,0:PRINT "> Return to Menu";:COLOR 14,0:PRINT "?":COLOR 3,0:RETURN
  243. 5100  IF ISET>=INEW THEN RETURN
  244. 5103  LOCATE 1,70:COLOR 16,7:PRINT " WORKING ":COLOR 3,0
  245. 5105  GET #1,ISET:LSET U$(15)=STR$(INEW):LSET U$(14)=U$(14):LSET U$(16)=U$(16)
  246. 5110  FOR J=1 TO 13:LSET U$(J)=U$(J):NEXT:PUT #1,ISET
  247. 5112  IF ISET=ISEND THEN 5125
  248. 5115  GET #1,ISEND:LSET U$(14)=STR$(INEW1+1):LSET U$(15)=U$(15):LSET U$(16)=U$(16)
  249. 5120  FOR J=1 TO 13:LSET U$(J)=U$(J):NEXT:PUT #1,ISEND
  250. 5125  GET #1,INEW:LSET U$(14)=STR$(ISET):LSET U$(15)=U$(15):LSET U$(16)=U$(16)
  251. 5130  FOR J=1 TO 13:LSET U$(J)=U$(J):NEXT:PUT #1,INEW
  252. 5135  FOR J=3 TO 13:LSET U$(J)="":NEXT
  253. 5140  NMID=(INT(INEW/2+0.5)):LSET U$(14)=STR$(INEW):LSET U$(15)=STR$(NMID):LSET U$(16)=STR$(ISET)
  254. 5145  LSET U$(1)=DATE$:LSET U$(2)=TIME$
  255. 5150  PUT #1,INEW+1:RETURN
  256. 5400  COLOR 14,0:LOCATE 3,15:PRINT SPACE$(50):LOCATE 3,15:PRINT MID$(V$(13),5,VAL(V$(13)));MID$(V$(1),5,VAL(V$(1)));" ";MID$(V$(2),5,VAL(V$(2)))
  257. 5410  FOR J= 3 TO 8:K=W(J):JJ=J+1:LOCATE JJ,15:PRINT MID$(V$(K),5,VAL(V$(K)));SPACE$(30):NEXT
  258. 5420  REM
  259. 5440  LOCATE 10,15:PRINT SPACE$(64):PRINT SPACE$(80):LOCATE 10,15:PRINT MID$(V$(9),5,VAL(V$(9))):RETURN
  260. 6000  ON KEY(8) GOSUB 4000:KEY(8) ON:ON KEY(7) GOSUB 20000:KEY(7) ON:ON KEY(9) GOSUB 960:KEY(9) ON
  261. 6010  ON KEY(1) GOSUB 420:ON KEY(2) GOSUB 402:KEY(1) ON:KEY(2) ON:ON KEY(3) GOSUB 400:KEY(3) ON:ON KEY(4) GOSUB 405:KEY(4) ON:ON KEY(5) GOSUB 410:ON KEY(6) GOSUB 415:KEY(6) ON:KEY(5) ON
  262. 6020  RETURN
  263. 6100  CLS:PRINT "TRANSFER RECORDS FROM ";:COLOR 1,3:PRINT FILE$;:COLOR 3,0:PRINT " TO . . . "
  264. 6101  DEF SEG =&H40:POKE &H17,&H40
  265. 6105  LOCATE 10,33:PRINT "Enter FILENAME":LOCATE 12,29:PRINT "[EXAMPLE:  B:ZIP-FIL]":LOCATE 14,30:PRINT "Default drive is ";F$:LOCATE 16,34:COLOR 14,0:GOSUB 35000:INPUT "FILENAME ... ",FILET$
  266. 6110  Z=INSTR(1,FILET$,":"):IF Z=0 THEN FILET$=F$+FILET$
  267. 6120  Z =INSTR(1,FILET$,"."):IF Z=0 THEN FILT$=FILET$:FILM2$=FILET$+".ISS":FILET$=FILET$+".DAT" ELSE FILM2$=LEFT$(FILET$,Z)+"ISS":FILT$=LEFT$(FILET$,Z-1)
  268. 6130  OPEN FILM2$ FOR INPUT AS #2
  269. 6135  COLOR 11,0:LOCATE 18,25:PRINT "Confirm Overwrite of ";:COLOR 12,0:PRINT FILET$:COLOR 3,0:LOCATE 20,35:PRINT "<Y> or <N>":COLOR 14,0:LOCATE 20,36:PRINT "Y":LOCATE 20,43:PRINT "N":COLOR 3,0
  270. 6140  Y$=INKEY$:IF Y$="" THEN 6140 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  271. 6145  IF Y$="Y" THEN 6150 ELSE CLOSE #2:RETURN 333
  272. 6150  INPUT #2,Y$,NRED,INEW,FILET$,FILT$,PT2$,SNN$,LP2,LP2$,T2$,SND$,TN2,F2$:CLOSE #2
  273. 6160  OPEN FILET$ AS #1 LEN = 356
  274. 6165  DEF SEG =&H40:POKE &H17,&H0
  275. 6170  FIELD #1, 19 AS U$(1), 19 AS U$(2), 18 AS U$(13), 34 AS U$(12), 34 AS U$(3), 34 AS U$(4), 19 AS U$(5), 14 AS U$(6), 16 AS U$(7), 12 AS U$(8), 84 AS U$(9), 19 AS U$(10), 19 AS U$(11), 5 AS U$(14), 5 AS U$(15), 5 AS U$(16)
  276. 6180  RETURN
  277. 6200  CLOSE #2:OPEN FILM2$ FOR OUTPUT AS #2
  278. 6205  FOR I= 1 TO 36:ZL(I)=1:NEXT
  279. 6210  WRITE #2,Y$,NRED,INEW,FILET$,FILT$,PT2$,SNN$,LP2,LP2$,T2$,SND$,TN2,F$:FOR I= 1 TO 36:WRITE #2, ZL(I):NEXT :CLOSE #2
  280. 6220  OPEN FILM$ FOR OUTPUT AS #2
  281. 6230  WRITE #2,Y$,NRED,NN,FILE$,FIL$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F$:FOR I= 1 TO 36:WRITE #2, ZL(I):NEXT:CLOSE #2:RETURN
  282. 9000  CLS:LOCATE 25,1:COLOR 0,7,1:PRINT O1$;:COLOR 3,0:LOCATE 1,1:RETURN
  283. 10110  FOR SD%=1 TO 3:SOUND 1000*SD%,1:NEXT:FOR SD%=3 TO 1 STEP -1:SOUND 1000*SD%,1:NEXT:RETURN
  284. 20000  IF ISET<INEW THEN GOSUB 5100:GOSUB 6200
  285. 20010  KY=9:N$=STR$(NN):A$="ADTRANS":CHAIN "ADNAME",20000,ALL
  286. 30000  CLS:LOCATE 25,25:COLOR 1,7,1:PRINT "INTEGRATED SOFTWARE SYSTEMS";:COLOR 3,0:LOCATE 1,1
  287. 30005  IF ISET<INEW THEN GOSUB 5100:GOSUB 6200
  288. 30010  OPEN "AD.HLP" AS #2 LEN=78
  289. 30020  FIELD #2, 78 AS A$
  290. 30030  I=1:M=1
  291. 30040  GET #2,I
  292. 30090  IF LEFT$(A$,1) <> CHR$(15) THEN PRINT A$ :I=I+1:GOTO 30040 ELSE 30130
  293. 30130  COLOR 0,7:LOCATE 24,27:PRINT "HIT ANY KEY TO CONTINUE";:COLOR 3,0:GOSUB 35030
  294. 30140  Y$=INKEY$:IF Y$="" THEN 30140
  295. 30150  CLOSE #2:GOTO 960
  296. 35000  IF SND$ ="N" THEN RETURN ELSE FOR SS%=1 TO 4:SOUND 500*SS%,2:NEXT:RETURN
  297. 35010  IF SND$ = "N" THEN RETURN ELSE FOR SS%=1 TO 3:SOUND 1000*SS%,1:NEXT:FOR SS%= 3 TO 1:SOUND 1000*SS%,1:NEXT:RETURN
  298. 35030  IF SND$ = "N" THEN RETURN ELSE SOUND 523.25,2:SOUND 30000,2:SOUND 523.25,2:RETURN
  299. 35040  IF SND$ = "N" THEN RETURN ELSE BEEP:RETURN
  300.